#!/usr/bin/perl -w

require 'common.pl';

my $sys_bits;

sub get_reg_value {
  my ($reg, $tstamp) = @_;

  my @v = &do_query( { cmd => 'readReg', TStamp => $tstamp,
                      $reg => 128 } );
  die unless scalar(@v) >= 1;
  my $r = $v[0]->{$reg};
  die unless defined($r);
  return eval("0x".$r);
}

sub byteswap_hex {
  my ($s) = @_;
  my $r = "";
  while (length($s) > 0) {
    $r = substr($s,0,2).$r;
    $s = substr($s,2);
  }
  return $r;
}

sub get_param_value {
  my ($name, $tstamp) = @_;

  my @v = &do_query( { cmd => 'getParameters', TStamp => $tstamp } );
  foreach my $v (grep { $_->{name} } @v) {
    if ($v->{name} eq $name) {
      my $valKey = $v->{valKey};
      my $typeKey= $v->{typeKey};
      die unless defined($valKey) && defined($typeKey);

      @v = &do_query( { cmd => 'getLocation', TStamp => $tstamp,
                        valKey => $valKey, typeKey => $typeKey });
      my @locations = grep { defined($_->{valueBitStart}) } @v;
      # Right now we'll only handle one register or memory location
      die "Multiple locations unsupported" unless scalar(@locations) == 1;
      my $loc = $locations[0];
      die "Bit-offset location unsupported" unless $loc->{valueBitStart} == 0;
      my $bitLength = $loc->{bitLength};
      die unless defined($bitLength);
      if ($loc->{type} eq "register") {
        my $reg = $loc->{register};
        die unless defined($reg);
        my $v = &get_reg_value($reg, $tstamp);
        die "Register bit offsets not supported" unless $loc->{registerBitOffset} == 0;
        if ($bitLength > 0) {
          $v = $v & ((1 << $bitLength) - 1);
        }
        return $v;
      } elsif ($loc->{type} eq "memory") {
        my $address = $loc->{address};
        die "Address bit offsets not supported" unless $loc->{addressBitOffset} == 0;
	my $bytes = $bitLength > 0 ? int(($bitLength + 7)/8) : $sys_bits/8;
        @v = &do_query( { cmd => 'readMem', TStamp => $tstamp,
                          ranges => [ { start => $address, length => $bytes } ] } );
        my @mem = grep { $_->{bytes} } @v;
        die "Multi-range or mmapped memory not supported" unless scalar(@mem) == 1;
	die unless $mem[0]->{start} == $address;
        die unless $mem[0]->{length} == $bytes;
        my $data = &byteswap_hex($mem[0]->{bytes});
        my $v = eval("0x".$data);
	if ($bitLength > 0) {
	  $v = $v & ((1 << $bitLength) - 1);
	}
	return $v;
      } else {
        die "Unknown type in location: ", join('#',%{$loc});
      }
    }
  }
  die "Variable $name not found";
}

my @v = &do_query( { cmd => 'info' } );
die unless scalar(@v) >= 1;
my $arch = $v[0]->{arch};
die unless defined($arch);

my $SPreg = $arch eq 'x86' ? 'esp' : 'rsp';
$sys_bits = $arch eq 'x86' ? 32 : 64;

my @local1Entry = &find_function_calls('local1');
die unless scalar(@local1Entry) == 1;

my $aValue = &get_param_value('a', $local1Entry[0]->{TStamp});
die unless $aValue == 3;
my $bValue = &get_param_value('b', $local1Entry[0]->{TStamp});
die unless $bValue == 5;

my @call1Entry = &find_function_calls('call1');
die unless scalar(@call1Entry) == 1;

my $call1SP = &get_reg_value($SPreg, $call1Entry[0]->{TStamp}); 

my @call2Entry = &find_function_calls('call2');
die unless scalar(@call2Entry) == 1;

my $call2SP = &get_reg_value($SPreg, $call2Entry[0]->{TStamp}); 

die unless $call2SP < $call1SP;

